home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / resocd / res_main.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-08  |  7.4 KB  |  212 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    BorderStyle     =   0  'None
  4.    Caption         =   "Resource Bar"
  5.    ClientHeight    =   360
  6.    ClientLeft      =   3465
  7.    ClientTop       =   3615
  8.    ClientWidth     =   4200
  9.    FontBold        =   -1  'True
  10.    FontItalic      =   0   'False
  11.    FontName        =   "MS Sans Serif"
  12.    FontSize        =   12
  13.    FontStrikethru  =   0   'False
  14.    FontUnderline   =   0   'False
  15.    Height          =   765
  16.    Icon            =   RES_MAIN.FRX:0000
  17.    Left            =   3405
  18.    LinkMode        =   1  'Source
  19.    LinkTopic       =   "Form1"
  20.    MaxButton       =   0   'False
  21.    MinButton       =   0   'False
  22.    ScaleHeight     =   360
  23.    ScaleWidth      =   4200
  24.    Top             =   3270
  25.    Width           =   4320
  26.    Begin PictureBox Panel1 
  27.       BackColor       =   &H000000FF&
  28.       Height          =   1000
  29.       Left            =   0
  30.       ScaleHeight     =   975
  31.       ScaleWidth      =   975
  32.       TabIndex        =   0
  33.       Top             =   0
  34.       Width           =   1000
  35.       Begin Timer Timer1 
  36.          Interval        =   750
  37.          Left            =   0
  38.          Top             =   0
  39.       End
  40.       Begin Label Label1 
  41.          Alignment       =   2  'Center
  42.          BackColor       =   &H00C0C0C0&
  43.          Caption         =   "--------- I N I T I A L I Z I N G ---------"
  44.          FontBold        =   0   'False
  45.          FontItalic      =   0   'False
  46.          FontName        =   "MS Sans Serif"
  47.          FontSize        =   8.25
  48.          FontStrikethru  =   0   'False
  49.          FontUnderline   =   0   'False
  50.          ForeColor       =   &H00000000&
  51.          Height          =   255
  52.          Left            =   60
  53.          TabIndex        =   1
  54.          Top             =   65
  55.          Width           =   4075
  56.       End
  57.    End
  58. Sub Escape_Now ()
  59. 'Take away the ON TOP feature in case user has
  60. ' positioned "bar" in front of message box then
  61. ' put the question to them. Then either exit or reinstate
  62. ' the ON TOP feature.
  63.     NotOnTop% = SetWindowPos(Form1.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
  64.     Answer% = MsgBox("Terminate Resource Bar?", 36, "Resource Bar")
  65.     If Answer% = 6 Then End
  66.     If Answer% = 7 Then OnTop% = SetWindowPos(Form1.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
  67. End Sub
  68. Sub Form_DragDrop (Source As Control, X As Single, Y As Single)
  69. 'Move form with mouse
  70. Call GetCursorPos(CurPos)
  71.     Call ScreenToClient(Form1.hWnd, CurPos)
  72.     NewPosX% = CurPos.X - MyPosX%
  73.     NewPosY% = CurPos.Y - MyPosY%
  74. End Sub
  75. Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
  76. 'bring up the help or escape forms if asked
  77. If KeyCode = Escape Then Call Escape_Now
  78. If KeyCode = KEY_F1 Then Call Help_Me
  79. 'Move form around with arrow keys
  80. If KeyCode = DownArrow Then Form1.Top = Form1.Top + 300
  81. If KeyCode = UpArrow Then Form1.Top = Form1.Top - 300
  82. If KeyCode = RightArrow Then Form1.Left = Form1.Left + 300
  83. If KeyCode = LeftArrow Then Form1.Left = Form1.Left - 300
  84. End Sub
  85. Sub Form_Load ()
  86. NL$ = Chr$(13) + Chr$(10) 'carrage return for message boxes
  87. '-- Extract the Major and Minor revisions and build
  88. '    the version strings (this won't run in Win 3.0)
  89. I% = GetVersion()
  90.      ' lowbyte is derived by masking off high byte
  91.      lowbyte$ = Str$(I% And &HFF)
  92.      ' highbyte is derived by masking off low byte and shifting
  93.      highbyte$ = LTrim$(Str$((I% And &HFF00) / 256))
  94.      ' assign windows version to text property
  95.      CurrentVersion# = Val(lowbyte$ + "." + highbyte$)
  96. If CurrentVersion# < 3.1 Then
  97.     MsgBox "This Program Must Have Windows" + NL$ + "Version 3.1 Or Higher", 16, "Resource Bar"
  98.     End
  99. End If
  100. 'Position in lower right corner
  101. Form1.Top = Screen.Height - Form1.Height
  102. Form1.Left = Screen.Width - Form1.Width
  103.  'Stay on Top
  104. OnTop% = SetWindowPos(Form1.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
  105. FOCUS = True
  106. 'read .ini file
  107.  'Does user want BigBen,DING, or nothing at top of hour
  108. AppName$ = "RESOURCE BAR"
  109. KeyName$ = "TOPOFHOUR"
  110. DefltStr$ = "BIGBEN"
  111. Dim RetStr As String * 255
  112. RetStr$ = String$(255, 0)
  113. nSize% = 255
  114. FileName$ = "RESOURCE.INI"
  115. LngthOfRetStr% = GetPrivateProfileString(AppName$, KeyName$, DefltStr$, RetStr$, nSize%, FileName$)
  116. TopOfHour$ = UCase$(Left$(RetStr$, LngthOfRetStr%))
  117.  'Does user want DING or nothing at bottom of hour
  118. AppName$ = "RESOURCE BAR"
  119. KeyName$ = "BOTTOFHOUR"
  120. DefltStr$ = "DING"
  121. RetStr$ = String$(255, 0)
  122. nSize% = 255
  123. FileName$ = "RESOURCE.INI"
  124. LngthOfRetStr% = GetPrivateProfileString(AppName$, KeyName$, DefltStr$, RetStr$, nSize%, FileName$)
  125. BottOfHour$ = UCase$(Left$(RetStr$, LngthOfRetStr%))
  126. End Sub
  127. Sub Form_LostFocus ()
  128. Form1.Label1.BackColor = Grey
  129. Form1.Label1.ForeColor = Black
  130. Form1.Panel1.BackColor = Grey
  131. End Sub
  132. Sub Label1_Click ()
  133. FOCUS = True
  134. Form1.Label1.BackColor = Blue
  135. Form1.Label1.ForeColor = White
  136. Form1.Panel1.BackColor = Red
  137. End Sub
  138. Sub Label1_DblClick ()
  139. Form2.Show
  140. End Sub
  141. Sub Label1_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  142. 'Move form with mouse
  143. Call GetCursorPos(CurPos)
  144.       Call ScreenToClient(Form1.hWnd, CurPos)
  145.       MyPosX% = CurPos.X
  146.       MyPosY% = CurPos.Y
  147. End Sub
  148. Sub Label1_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  149. 'Move form with mouse
  150. If Button = Left_Button Then
  151.     Call GetCursorPos(CurPos)
  152.     NewPosX% = CurPos.X - MyPosX%
  153.     NewPosY% = CurPos.Y - MyPosY%
  154.     'Call origionally I put junk% =
  155.        junk% = SetWindowPos(Form1.hWnd, 0, NewPosX%, NewPosY%, 0&, 0&, SWP_NOSIZE)
  156.       End If
  157. End Sub
  158. Sub SaveIni (AppName$, IniFileName$, KeyName$, NewVal$)
  159.     ' Update INI file
  160.     ResultCode% = WritePrivateProfileString(AppName$, KeyName$, NewVal$, IniFileName$)
  161.     If ResultCode% = 0 Then
  162.     MsgBox "Error updating INI file!", 16, "ERROR!"
  163.     End If
  164. End Sub
  165. Sub Timer1_Timer ()
  166. 'Gather info for bar
  167. SysRes% = GetFreeSystemResources(GFSR_SYSTEMRESOURCES)
  168. Memory& = GetFreeSpace(0)
  169. MemFree$ = Format$((Memory& / 1000), "#####") + " Kb,"
  170. 'Putting today's date and current time on the lable 1st, then the day, then the date, then the Kb, then the % Free
  171. Form1.Label1.Caption = Format$(Now, "h:mm:ss AM/PM") + ", " + Format$(Now, "ddd") + " " + Format$(Now, "m/d/yy") + " - " + MemFree$ + Str$(SysRes%) + "% Free"
  172. 'DING on the hour
  173.     'Check for top of hour
  174. If TopOfHour$ <> "NONE" Then 'If user didn't select "no
  175.                  ' sound" then continue
  176.     If TopOfHour$ = "BIGBEN" Then
  177.     Top1$ = "bigben"
  178.     Top2$ = "ben"
  179.     End If
  180.     If TopOfHour$ = "DING" Then
  181.     Top1$ = "ding"
  182.     Top2$ = "ding"
  183.     End If
  184.     If Right$(Format$(Now, "h:mm:ss"), 5) = "00:00" Then
  185.     The_Hour% = Val(Left$(Format$(Now, "h:mm am/pm"), 2))
  186.     The_Hour% = The_Hour% - 1 'allow for the "windup chime" vs "reg. chime"
  187.     result1% = SndPlaySound(Top1$ + ".wav", 0)
  188.         For I% = 1 To The_Hour%
  189.         result2% = SndPlaySound(Top2$ + ".wav", 0)
  190.         Next I%
  191.     End If
  192. End If
  193. 'DING on 1/2 hr
  194. If BottOfHour$ <> "NONE" Then 'If user didn't select "no
  195.                   ' sound" then continue
  196. 'check for the bott. of hour
  197.     If Mid$(Format$(Now, "hh:mm:ss"), 4, 5) = "30:00" Then
  198.     result3% = SndPlaySound("ding.wav", 0)
  199.     End If
  200. End If
  201. 'Watch when form loses focus
  202. If FOCUS = True Then
  203.      ' Compare the handle of the currently active Window
  204.      ' with the handle of the Form1 window:
  205.      If GetActiveWindow() <> Form1.hWnd Then
  206.     'Do form's lost-focus routines here.
  207.     Call Form_LostFocus
  208.     FOCUS = False
  209.      End If
  210.     End If
  211. End Sub
  212.